An Analysis of TF2 Server Game Info 

library(ggplot2)
theme_set(theme_minimal()) # ggplot2 theme
library(plotly)
library(knitr)

library(jsonlite)
library(dotenv)
library(mongolite)

load_dot_env(file = ".env")

con <- mongo(
    db = "tf2",
    collection = "snapshots",
    url = Sys.getenv("MONGODB_CONN_STRING")
)
start.time <- Sys.time()

# get data from mongodb
# sg
data <- con$find(
    '{ "info.server_name": {"$regex": "Singapore", "$options": "i"} }',
    '{ "playerCount": { "$size": "$players" }, "timestamp": 1, "_id": 0 }'
)

# # sg and hk
# data_all <- con$find(
#     fields = '{ "playerCount": { "$size": "$players" }, "timestamp": 1, "_id": 0 }'
# )

# finish timing
end.time <- Sys.time()
time.taken <- end.time - start.time
time.taken
## Time difference of 2.896264 secs
start.time <- Sys.time()

# group by timestamp
df <- aggregate(
    data$playerCount,
    by = list(Category = data$timestamp),
    FUN = sum
)

names(df)[names(df) == 'x'] <- 'count'
names(df)[names(df) == 'Category'] <- 'unixTS'

# convert timestamp to date type
convertTimestamp <- function(ts){
    date <- as.POSIXct(ts, origin = "1970-01-01")
    return(date)
}

df$timestamp <- convertTimestamp(df$unixTS)

# setting up for ggplot rectangles
v <- df$timestamp %>%
    weekdays()

isWeekend <- function(weekdayStr) {
    if (weekdayStr %in% c("Saturday", "Sunday")) {
        return(1)
    }
    else {
        return(0)
    }
}

# https://stackoverflow.com/questions/32543176/highlight-areas-within-certain-x-range-in-ggplot2
# create rectangles to highlight in ggplot
v <- sapply(v, isWeekend)

## Get the start and end points for highlighted regions
inds <- diff(c(0, v))
start <- df$timestamp[inds == 1]
end <- df$timestamp[inds == -1]
if (length(start) > length(end)) end <- c(end, tail(df$timestamp, 1))

## highlight region data
rects <- data.frame(start=start, end=end, group=seq_along(start))

# finally creating the plot
g <- ggplot(
    df,
    aes(
        x = timestamp,
        y = count
    )
) +
    scale_x_datetime(
        breaks = "1 day",
        date_labels = "%d %b",
    ) +
    geom_rect(data = rects,
        inherit.aes = FALSE,
        aes(
            xmin = start,
            xmax = end,
            ymin = min(df$count),
            ymax = max(df$count),
            group = group
        ),
        color = "transparent",
        fill = "orange", alpha = 0.2
    ) +
    geom_line() +
    labs(
        title = "Concurrent Players in TF2 Casual Servers (Singapore)",
        x = "Time (GMT +8)",
        y = "Player Count",
    )

# display plot and disable hover info for rects layer
ggplotly(g) %>%
    style(hoverinfo = "none", traces = 1)
# finish timing
end.time <- Sys.time()
time.taken <- end.time - start.time
time.taken
## Time difference of 0.7760429 secs
# https://stats.stackexchange.com/questions/36309/how-do-i-find-peaks-in-a-dataset
# https://rpubs.com/mengxu/peak_detection

x <- df$unixTS[-(1:6000)]
y <- df$count[-(1:6000)]

argmax <- function(x, y, w=1, ...) {
  require(zoo)
  n <- length(y)
  y.smooth <- loess(y ~ x, ...)$fitted
  y.max <- rollapply(zoo(y.smooth), 2*w+1, max, align="center")
  delta <- y.max - y.smooth[-c(1:w, n+1-1:w)]
  i.max <- which(delta <= 0) + w
  list(x=x[i.max], i=i.max, y.hat=y.smooth)
}

w <- 50  # range to find peaks
span <- 0.02 # smoothing factor

# test <- function(w, span) {
    peaks <- argmax(x, y, w=w, span=span)

    plot(x, y, cex=0.75, col="Gray", main=paste("w = ", w, ", span = ", span, sep=""))
    lines(x, peaks$y.hat,  lwd=2) #$
    y.min <- min(y)
    sapply(peaks$i, function(i) lines(c(x[i],x[i]), c(y.min, peaks$y.hat[i]), col="Red", lty=2))
## [[1]]
## NULL
## 
## [[2]]
## NULL
## 
## [[3]]
## NULL
## 
## [[4]]
## NULL
## 
## [[5]]
## NULL
## 
## [[6]]
## NULL
## 
## [[7]]
## NULL
## 
## [[8]]
## NULL
## 
## [[9]]
## NULL
## 
## [[10]]
## NULL
## 
## [[11]]
## NULL
## 
## [[12]]
## NULL
## 
## [[13]]
## NULL
## 
## [[14]]
## NULL
    points(x[peaks$i], peaks$y.hat[peaks$i], col="Red", pch=19, cex=1.25)

# }

x[peaks$i] %>% 
    convertTimestamp() %>% 
    format("%d %b, %I:%M:%S %p")
##  [1] "26 Jun, 03:43:43 PM" "26 Jun, 10:13:43 PM" "27 Jun, 04:11:12 PM" "27 Jun, 10:25:00 PM" "28 Jun, 05:19:11 PM" "28 Jun, 09:06:59 PM" "29 Jun, 04:59:46 PM" "29 Jun, 09:46:16 PM"
##  [9] "30 Jun, 05:34:14 PM" "30 Jun, 09:49:14 PM" "01 Jul, 05:04:58 PM" "01 Jul, 10:01:58 PM" "02 Jul, 05:15:34 PM" "02 Jul, 09:57:34 PM"
start.time <- Sys.time()

# timestamp of most recent set of server data in mongo
last_ts <- tail(df, n = 1)$unixTS

query_str <- paste('{ "timestamp":', last_ts, '}')
most_recent_scan <- con$find(query_str)

pretty_date <- convertTimestamp(last_ts) %>% 
                format("%d %b, %I:%M:%S %p")

paste("Servers with Players at", pretty_date, "<br>Next scan will happen 3 minutes from that time") %>% 
    cat()

replace_unicode_format <- function(unicode_str){
    # actual str is <U+0223>
    # take &lt;U+0223&gt;
    # return &#x0223;
    html_unicode <- paste("&#x", substr(unicode_str, 7, 10), ";", sep = "")
    return(html_unicode)
}

fix_unicode <- function(html_string){
    stringr::str_replace_all(
        html_string,
        "&lt;U\\+([0-9A-F]{4,8})&gt;",
        replace_unicode_format
    )
}


for (i in 1:nrow(most_recent_scan)){
    server_data <- most_recent_scan[i,]
    # server data, tranposed for key: val layout
    kable(server_data[1:3] %>% t(), format = "html") %>%
        print()

    # player data
    # sanitise player names
    server_data$players[[1]]$name <- server_data$players[[1]]$name %>%
        htmltools::htmlEscape() # %>%
        # textutils::HTMLencode()

    # debugging - REMOVE WHEN DONE TESTING

    # format table and display
    server_data$players[[1]] %>%
        kable(format = "html") %>%
        fix_unicode() %>%
        print()
}

end.time <- Sys.time()
time.taken <- end.time - start.time
time.taken